home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 008 / cadence.arc / VOL2NO1.ARC / FILLET2.LSP < prev    next >
Encoding:
Text File  |  1987-05-18  |  1.1 KB  |  32 lines
  1. ; FILLET2.LISP
  2. ; by Dan Moran
  3. ;
  4. (defun C:FILLET2 (/ A B AN BN AE BE AANG BANG TANA TANB TAND NS RS R C)
  5.   (setvar "CMDECHO" 0)
  6.   (setq B (entsel "Pick changing line: "))
  7.   (setq BN (osnap (cadr B) "near"))
  8.   (setq BE (osnap (cadr B) "end"))
  9.   (setq A (entsel "\nPick unchanging line: "))
  10.   (setq AN (osnap (cadr A) "near"))
  11.   (setq AE (osnap (cadr A) "end"))
  12.   (setq NS (inters AN AE BN BE nil))
  13.   (setq RS (strcat "Radius <" (rtos (getvar "FILLETRAD")) ">: "))
  14.   (setq R (getreal RS))
  15.   (if R (setvar "FILLETRAD" R); THEN
  16.        (setq R (getvar "FILLETRAD")); ELSE
  17.      )
  18.   (setq AANG (angle NS AN))
  19.   (setq BANG (angle NS BN))
  20.   (setq C (-BANG AANG))
  21.   (if (> C PI)(setq C (-C (* 2.0 PI))))
  22.   (if (< C(-PI))(setq C (+C (* 2.0 PI))))
  23.   (setq TAND (abs (/(* R (cos (/ C2.0)))(sin(/C 2.0)))))
  24.   (setq TANA (polar NS AANG TAND))
  25.   (setq TANB (polar NS BANG TAND)) 
  26.   ((if (minusp C)(command "ARC" TANA "E" TANB "R" R); Then 
  27.                  (command "ARC" TANB "E" TANA "R" R); Else
  28.   )
  29.   (command "CHANGE" (car B) " " TANB)
  30.   (setvar "CMDECHO" 1)
  31. )
  32.